-- From http://homepage.ntlworld.com/ian.sharpe/isharpe/technote/ada_sl.htm  

with Interfaces;
with Interfaces.C;
use Interfaces.C;
with Interfaces.C.Strings;
use Interfaces.C.Strings;
with Unchecked_Conversion;

package body Dll is

       -- Map UNIX-style dynamic-library functions to ada routines

       function Dlopen (Lib_Name : Interfaces.C.Strings.Chars_Ptr;
			Mode     : Interfaces.C.int) return System.Address;
       pragma Import(C, Dlopen, "dlopen");

       function Dlsym (Handle   : System.Address;
		       Sym_name : Interfaces.C.Strings.Chars_Ptr) return System.Address;
       pragma Import(C, Dlsym, "dlsym");

       function Dlclose (Handle : System.Address) return Interfaces.C.int;
       pragma Import(C, Dlclose, "dlclose");

       function Dlerror return Interfaces.C.Strings.Chars_Ptr;
       pragma Import (C, Dlerror, "dlerror");



       function Error(Handle : in Handle_Type) return String is
	  C_Str : Interfaces.C.Strings.Chars_Ptr;
       begin
	  C_Str := Dlerror;

	   if C_Str = Interfaces.C.Strings.Null_Ptr then
	      return "";
	   else
	      return Interfaces.C.Strings.Value(C_Str);
	  end if;
       end Error;


       procedure Open(Handle : in out Handle_Type;
		      Name   : in     String;
		      Mode   : in     Integer := 0) is
	  Raw_Address : System.Address;
	  C_Str       : Chars_Ptr;
       begin
	  C_Str := Interfaces.C.Strings.New_String(Name);

	  Raw_Address := Dlopen(Lib_Name => C_Str,
				Mode     => Interfaces.C.Int(Mode));

	  Interfaces.C.Strings.Free(C_Str);

	  Handle.Os_Handle := Raw_Address;

	  if Raw_Address = System.Null_Address then raise Dll_Exception; end if;

       end;

       procedure Close(Handle : in out handle_type) is
	  Os_Ret_Code : Interfaces.C.Int;
       begin
	  Os_Ret_Code := Dlclose(Handle.Os_Handle);

	  if Os_Ret_Code /= 0 then raise Dll_Exception; end if;

       end Close;


       procedure Sym(Handle : in out Handle_Type;
		     Name   : in     String;
		     Item   :    out Item_Type) is
	  function Address_To_Access is new
	    Unchecked_Conversion(Source => System.Address, Target => Item_Type);
	  Raw_Address : System.Address;
	  C_Str       : Chars_Ptr;
       begin
	  C_Str := Interfaces.C.Strings.New_String(Name);

	  Raw_Address := Dlsym(Handle   => Handle.Os_handle,
			       Sym_Name => C_Str);

	  Interfaces.C.Strings.Free(C_Str);

	  Item := Address_To_Access(Raw_Address);

	  if Raw_Address = System.Null_Address then raise Dll_Exception; end if;

       end;

    end Dll;

